
#include <assert.h>

#include "utility/olisp_macro_subst.h"
#include "utility/olisp_helpers.h"
#include "utility/olisp_reader.h"
#include "utility/olisp_utils.h"
#include "core/olisp_mem.h"

/*
 * disposes a resources allocated to a macro substitution
 */
static void dispose_subst( subst_t * s )
{
    if( s->name )
        RELEASE( s->name );

    if( s->arg_list )
        RELEASE( s->arg_list );

    if( s->body )
        RELEASE( s->body );

    lisp_free( s );
}

/*
 * manages subst collection
 */

#define MACRO_COL_GROW_SIZE     256

static int add_macro( subst_collection_t * c, subst_t * s )
{
    size_t new_len;
    size_t n;

    // find an existing element
    for( n = 0; n < c->length; ++ n )
    {
        subst_t * l = c->substs[n];
        if( id_as_hash(l->name) == id_as_hash(s->name) )
        {
            // redefine macro
            dispose_subst( l );
            c->substs[n] = s;
            return 1;
        }
    }

    // add new element
    new_len = c->length + 1;
    if( new_len > c->allocated )
    {
        size_t new_alloc = c->allocated + MACRO_COL_GROW_SIZE;
        subst_t ** substs = lisp_realloc( c->substs, new_alloc );
        if( !substs )
            return 0;

        c->substs = substs;
        c->allocated = new_alloc;
    }

    c->substs[c->length] = s;
    c->length = new_len;

    return 1;
}

static void remove_all_macros( subst_collection_t * c )
{
    if( c->substs )
    {
        size_t n;
        for( n = 0; n < c->length; ++ n )
            dispose_subst( c->substs[n] );

        lisp_free( c->substs );
    }

    c->substs = 0;
    c->length = 0;
    c->allocated = 0;
}


/*
 * finds a substition which corresponds to certain macro definition
 */
static subst_t * find_subst(
        subst_collection_t * col,
        lisp_hash_t name_hash )
{
    subst_collection_t * c = col;
    for( ;; )
    {
        size_t n;
        for( n = 0; n < c->length; ++ n )
        {
            subst_t * s = c->substs[n];
            if( name_hash == id_as_hash(s->name) )
            {
                return s;
            }
        }

        if( !c->prev_col )
            break;

        c = c->prev_col;
    }
    return 0;
}



/*
 * creates a macro definition which represents a macros structure
 */
static subst_t * create_macro_def(
    macro_substitutor_context_t * ctx,
    list_obj_t * elem
    )
{
    size_t len = list_length( elem );
    subst_t * s = 0;
        
    s = lisp_mallocz( sizeof(subst_t) );
    if( !s )
        goto LFail;
    
    // at least a name and an argument list should be
    if( len < 3 )
    {
        interpreter_message( ctx->interpreter, MSG_SEV_ERROR, (obj_t *)elem,
                "lack of the arguments in a macro definition" );
        goto LFail;
    }

    // get name
    s->name = (id_obj_t *)list_get_elem( elem, 1 );
    if( s->name->vtbl->element_type != LISP_ELEM_ID )
    {
        interpreter_message( ctx->interpreter, MSG_SEV_ERROR, (obj_t *)elem,
                "name is missing in a macro declaration" );
        s->name = 0;
        goto LFail;
    }
    ADDREF( s->name );

    // get arg list
    s->arg_list = list_get_elem( elem, 2 );
    if( s->arg_list->vtbl->element_type != LISP_ELEM_NIL &&
        s->arg_list->vtbl->element_type != LISP_ELEM_LIST )
    {
        interpreter_message( ctx->interpreter, MSG_SEV_ERROR, (obj_t *)elem,
                "argument list is missing in a macro declaration" );

        s->arg_list = 0;
        goto LFail;
    }
    ADDREF( s->arg_list );

    // get body - if no body is specified - macro will be expanded to
    // the nil construction
    if( len > 3 )
    {
        size_t n;
        list_obj_t * body = create_list( len - 3 );
        if( !body )
            goto LFail;

        for( n = 3; n < len; ++ n )
        {
            list_set( body, n - 3, list_get_elem(elem, n) );
        }

        s->body = (obj_t *)body;
    }
    else
    {
        s->body = nil_elem;
    }

    return s;

LFail:
    dispose_subst( s );
    return 0;
}

static subst_t * handle_defmacro(
    macro_substitutor_context_t * ctx,
    list_obj_t * elem
    )
{
    subst_t * s = create_macro_def( ctx, elem );
    if( s )
    {
        if( !add_macro(&ctx->defs, s) )
        {
            dispose_subst( s );
            return 0;
        }
    }

    return s;
}

/*
 * apply macro substitution
 */
static obj_t * apply_macro_subst(
    macro_substitutor_context_t * ctx,
    list_obj_t * elem,
    subst_t * subst
    )
{
    // TODO: match arg list

    // body is empty
    if( subst->body->vtbl->element_type == LISP_ELEM_NIL )
    {
        return nil_elem;
    }

    return (obj_t *)create_string( "TODO: create subst" );
}

/*
 * handles a list with macros within
 */
static obj_t * handle_list_with_macros(
    macro_substitutor_context_t * ctx,
    list_obj_t * elem
    )
{
    subst_t * s;
    id_obj_t * macro_name = (id_obj_t *)list_get_elem( elem, 0 );

    ;

    // conversion validity checks
    if( macro_name->vtbl->element_type != LISP_ELEM_ID )
        goto LNoSubst;

    s = find_subst( &ctx->defs, id_as_hash((id_obj_t *)macro_name) );
    if( s )
    {
        // substitution found - apply this one
        return apply_macro_subst( ctx, elem, s );
    }

LNoSubst:
    // no subst found - return a list itself
    ADDREF( elem );
    return (obj_t *)elem;
}

/*
 * two types of macro construction:
 */
static obj_t * do_subst(
    macro_substitutor_context_t * ctx,
    list_obj_t * elem
    )
{
    size_t len = list_length( elem );
    
    // empty list?
    if( !len )
        return nil_elem;

    // TODO: handle (load "name") definitions

    // defmacro definition?
    if( lisp_equal(list_get_elem(elem, 0), ctx->defmacro_name) )
    {
        // in a common lisp implementation defmacro returns the name of a
        // macro been registered
        subst_t * s = handle_defmacro( ctx, elem );
        if( s )
        {
            ADDREF( s->name );
            return (obj_t *)s->name;
        }

        return nil_elem;
    }

    // do traverse a list and find a macro definitions inside
    return handle_list_with_macros( ctx, elem );
}





list_obj_t * macro_read( macro_substitutor_context_t * ctx )
{
    reader_context rdr_ctx = { 0 };
    list_obj_t * result = create_list( 0 );

    if( !result )
        goto LFail;

    // create default defmacro token
    if( !ctx->defmacro_name )
    {
        ctx->defmacro_name = (obj_t *)create_identifier( "defmacro" );
        if( !ctx->defmacro_name )
            goto LFail;
    }


    // init reader context
    rdr_ctx.err_handler = ctx->interpreter;
    rdr_ctx.quote_mgr = ctx->quote_mgr;
    rdr_ctx.stream = ctx->stream;
    rdr_ctx.stream_name = ctx->stream_name;
    rdr_ctx.line = 1;

    // read all elements in stream
    for( ;; )
    {
        obj_t * e = read_elem( &rdr_ctx );
        if( e )
        {
            int res = 0;

            // append unprocessed element as it was taken from reader
            if( ctx->unprocessed_list )
                list_append( ctx->unprocessed_list, e );

            // check whether this element is not marked
            if( e->vtbl->element_type == LISP_ELEM_LIST &&
                !quote_mgr_get_marker(ctx->quote_mgr, e) )
            {
                obj_t * subst_elem = do_subst( ctx, (list_obj_t *)e );
                if( subst_elem )
                    res = list_append( result, subst_elem );

                RELEASE( subst_elem );
            }
            else
            {
                // this is a pretty ordinary element - just add it to the list
                res = list_append( result, e );
            }

            RELEASE( e );

            if( !res )
                goto LFail;
        }
        else
            break;
    }

    return result;

LFail:
    if( result )
        RELEASE( result );
    return 0;
}

void dispose_macro_subst_context( macro_substitutor_context_t * ctx )
{
    if( ctx->defmacro_name )
    {
        RELEASE( ctx->defmacro_name );
        ctx->defmacro_name = 0;
    }

    if( ctx->unprocessed_list )
    {
        RELEASE( ctx->unprocessed_list );
        ctx->unprocessed_list = 0;
    }

    remove_all_macros( &ctx->defs );
}
